home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch11 / LeastSq.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-12  |  4KB  |  114 lines
  1. VERSION 5.00
  2. Begin VB.Form frmLeastSq 
  3.    Caption         =   "LeastSq"
  4.    ClientHeight    =   5310
  5.    ClientLeft      =   2085
  6.    ClientTop       =   615
  7.    ClientWidth     =   4830
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   5310
  11.    ScaleWidth      =   4830
  12.    Begin VB.CommandButton cmdGo 
  13.       Caption         =   "Go"
  14.       Default         =   -1  'True
  15.       Enabled         =   0   'False
  16.       Height          =   375
  17.       Left            =   2040
  18.       TabIndex        =   1
  19.       Top             =   4920
  20.       Width           =   615
  21.    End
  22.    Begin VB.PictureBox picCanvas 
  23.       AutoRedraw      =   -1  'True
  24.       Height          =   2535
  25.       Left            =   120
  26.       ScaleHeight     =   165
  27.       ScaleMode       =   3  'Pixel
  28.       ScaleWidth      =   229
  29.       TabIndex        =   0
  30.       Top             =   120
  31.       Width           =   3495
  32.    End
  33. Attribute VB_Name = "frmLeastSq"
  34. Attribute VB_GlobalNameSpace = False
  35. Attribute VB_Creatable = False
  36. Attribute VB_PredeclaredId = True
  37. Attribute VB_Exposed = False
  38. Option Explicit
  39. Private NumPts As Integer
  40. Private PtX() As Single
  41. Private PtY() As Single
  42. ' Compute the m and b values for the least squares line.
  43. Private Sub GetLeastSquaresValues(X() As Single, Y() As Single, ByRef m_value As Single, ByRef b_value As Single)
  44. Dim num_points As Integer
  45. Dim A As Single
  46. Dim B As Single
  47. Dim C As Single
  48. Dim D As Single
  49. Dim i As Integer
  50.     ' Compute the sums.
  51.     num_points = UBound(X)
  52.     For i = 1 To num_points
  53.         A = A + PtX(i) * PtX(i)
  54.         B = B + PtX(i)
  55.         C = C + PtX(i) * PtY(i)
  56.         D = D + PtY(i)
  57.     Next i
  58.     m_value = (B * D - C * num_points) / (B * B - A * num_points)
  59.     b_value = (B * C - A * D) / (B * B - A * num_points)
  60. End Sub
  61. Private Sub Form_Resize()
  62. Dim hgt As Single
  63.     cmdGo.Move (ScaleWidth - cmdGo.Width) / 2, ScaleHeight - cmdGo.Height
  64.     hgt = cmdGo.Top - 30
  65.     If hgt < 120 Then hgt = 120
  66.     picCanvas.Move 0, 0, ScaleWidth, hgt
  67. End Sub
  68. ' Add this point to the list of points.
  69. Private Sub picCanvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  70. Const GAP = 2
  71.     ' If this is the first point, erase the screen.
  72.     If NumPts < 1 Then picCanvas.Cls
  73.     ' Record the new point.
  74.     NumPts = NumPts + 1
  75.     ReDim Preserve PtX(1 To NumPts)
  76.     ReDim Preserve PtY(1 To NumPts)
  77.     PtX(NumPts) = X
  78.     PtY(NumPts) = Y
  79.     ' Display the point.
  80.     picCanvas.Line (X - GAP, Y - GAP)-(X + GAP, Y + GAP), , BF
  81.     ' If NumPts >= 2, enable the Go button.
  82.     If NumPts >= 2 Then cmdGo.Enabled = True
  83. End Sub
  84. ' Draw the least squares fit curve.
  85. Private Sub cmdGo_Click()
  86.     cmdGo.Enabled = False
  87.     DrawCurve
  88.     ' Prepare to get a new set of points.
  89.     NumPts = 0
  90. End Sub
  91. ' Draw the least squares line.
  92. Private Sub DrawCurve()
  93. Dim m_value As Single
  94. Dim b_value As Single
  95. Dim x1 As Single
  96. Dim x2 As Single
  97. Dim y1 As Single
  98. Dim y2 As Single
  99. Dim i As Integer
  100.     ' Get the m and b values for the line.
  101.     GetLeastSquaresValues PtX, PtY, m_value, b_value
  102.     ' Find the minimum and maximum X values.
  103.     x1 = PtX(1) ' This will be the minimum X value.
  104.     x2 = x1     ' This will be the maximum X value.
  105.     For i = 2 To NumPts
  106.         If x1 > PtX(i) Then x1 = PtX(i)
  107.         If x2 < PtX(i) Then x2 = PtX(i)
  108.     Next i
  109.     ' Draw the line.
  110.     y1 = m_value * x1 + b_value
  111.     y2 = m_value * x2 + b_value
  112.     picCanvas.Line (x1, y1)-(x2, y2)
  113. End Sub
  114.